home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / SCRMAKER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-10  |  14.2 KB  |  424 lines
  1. Unit ScrMaker;
  2.  
  3. Interface
  4.  
  5. Uses Crt;
  6.  
  7. Type
  8.    Line = String[79];
  9.    Draw = Object
  10.           WallChar:Char;
  11.           WColor:Byte;
  12.           Header:Line;
  13.           HColor:Byte;
  14.           Status:Line;
  15.           SColor:Byte;
  16.           LineMode:Boolean;
  17.           LineStyle:Array[1..11] Of Byte;
  18.           DrawMode:Boolean;
  19.           Constructor Init(F1,B1:Byte;S:Char;F2,B2:Byte;L1:Line;
  20.                            F3,B3:Byte;L2:Line);
  21.           Procedure   InitWall;Virtual;
  22.           Procedure   InitStatus;Virtual;
  23.           Procedure   InitHeader;Virtual;
  24.           Procedure   SetLineStyle(Mode:Boolean);Virtual;
  25.           Procedure   Help;Virtual;
  26.           Procedure   Run;
  27.           Destructor  Done;
  28.    End;
  29. Const
  30.    FileName:String[8]='ISIMSIZ';
  31.    FileExt:String[4]='.BIN';
  32.    SingleLine:Array[1..11] Of Byte=(218,191,192,217,196,179,194,193,195,180,197);
  33.    DoubleLine:Array[1..11] Of Byte=(201,187,200,188,205,186,203,202,204,185,206);
  34. Procedure ScrToFile(FileName:Line);
  35.  
  36. Implementation
  37.  
  38. Procedure Go(X, Y:Byte);Assembler;
  39. Asm
  40.    Mov Ah,02h
  41.    Mov Bh,00h
  42.    Mov Dh,Y
  43.    Mov Dl,X
  44.    Int 10h
  45. End;
  46. Procedure StdCursor;Assembler;
  47. Asm
  48.    Mov Ax,0100h
  49.    Mov Cx,1e1fh
  50.    Int 10h
  51. end;
  52. Procedure BlockCursor;Assembler;
  53. Asm
  54.    Mov Ax,0100h
  55.    Mov Cx,001fh
  56.    Int 10h
  57. End;
  58. Function Segment:word;
  59. Begin
  60.    if (mem[0:$0410] and $30)=$30 then segment:=$b000
  61.                                  else segment:=$b800;
  62. End;
  63. Procedure ScrToFile(FileName:Line);
  64. Var
  65.    ScrFile : File;
  66. Begin
  67.    Assign(ScrFile,FileName);
  68.    {$I-} Reset(ScrFile, 4000); {$I+}
  69.    If IOResult <> 0 Then
  70.    Begin
  71.       {$I-} ReWrite(ScrFile, 4000); {$I+}
  72.       If IOResult <> 0 Then Exit;
  73.    End Else Seek(ScrFile,fileSize(ScrFile));
  74.    BlockWrite(ScrFile, Ptr(Segment, 0)^, 1);
  75.    Close(ScrFile);
  76. End;
  77. Constructor Draw.Init(F1,B1:Byte;S:Char;F2,B2:Byte;L1:Line;F3,B3:Byte;L2:Line);
  78. Begin
  79.    WColor:=B1 Shl 4+F1;
  80.    HColor:=B2 Shl 4+F2;
  81.    SColor:=B3 Shl 4+F3;
  82.    WallChar:=S;
  83.    LineMode:=True;
  84.    SetLineStyle(LineMode);
  85.    Header:=L1;
  86.    Status:=L2;
  87.    InitWall;
  88.    InitHeader;
  89.    InitStatus;
  90.    Go(0,1);
  91.    DrawMode:=False;
  92. End;
  93. Procedure Draw.InitWall;
  94. Var
  95.    Ix:Integer;
  96. Begin
  97.    For Ix:=0 To 2000 Do
  98.    MemW[Segment:Ix*2]:=WColor Shl 8+Ord(WallChar);
  99. End;
  100. Procedure Draw.InitStatus;
  101. Var
  102.    Ix:Integer;
  103. Begin
  104.    For Ix:=1920 To 2000 Do
  105.    If Ix-1919>Length(Status) Then MemW[Segment:Ix*2]:=SColor Shl 8+32
  106.    Else MemW[Segment:Ix*2]:=SColor Shl 8+Ord(Status[Ix-1919]);
  107. End;
  108. Procedure Draw.InitHeader;
  109. Var
  110.    Ix:Integer;
  111. Begin
  112.    For Ix:=0 To 79 Do
  113.    If (Ix+1>(79-Length(Header)) Div 2+Length(Header))
  114.    Or (Ix+1<=(79-Length(Header)) Div 2)
  115.    Then MemW[Segment:Ix*2]:=HColor Shl 8+32
  116.    Else MemW[Segment:Ix*2]:=HColor Shl 8+
  117.    Ord(Header[Ix-((79-Length(Header)) Div 2)+1]);
  118. End;
  119. Procedure Draw.SetLineStyle(Mode:Boolean);
  120. Var
  121.    Nx:Byte;
  122. Begin
  123.    Case Mode Of
  124.         True :For Nx:=1 To 11 Do LineStyle[Nx]:=SingleLine[Nx];
  125.         False:For Nx:=1 To 11 Do LineStyle[Nx]:=DoubleLine[Nx];
  126.    End;
  127. End;
  128. Procedure Draw.Help;
  129. Var
  130.    Save:Array[1..4000] Of Byte;
  131.    Key1:Char;
  132. Begin
  133.    Move(Mem[Segment:0],Save[1],4000);
  134.    Go(30,7); Write ('┌───────[ Tuƒlar ]──────┐');
  135.    Go(30,8); Write ('│Ctrl ÿle   │F7     ├,╠ │▓▓');
  136.    Go(30,9); Write ('│Home   ┌,╔ │F8     ┤,╣ │▓▓');
  137.    Go(30,10);Write ('│End    └,╚ │F9     ┬,╦ │▓▓');
  138.    Go(30,11);Write ('│PgUp   ┐,╗ │F10    ┴,╩ │▓▓');
  139.    Go(30,12);Write ('│PgDn   ┘,╝ │Oklar  │,║ │▓▓');
  140.    Go(30,13);Write ('│PrtScr ┼,╬ │Oklar  ─,═ │▓▓');
  141.    Go(30,14);Write ('└───────────┴───────────┘▓▓');
  142.    Go(33,15);   Write ('▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓');
  143.    Repeat
  144.       Key1:=ReadKey;
  145.    Until Key1=#27;
  146.    Move(Save,Mem[Segment:0],4000);
  147. End;
  148. Procedure Draw.Run;
  149. Var
  150.    Hea,Sta,Name:String;
  151.    Ch:Char;
  152.    Key:Word;
  153.    Ix,Jx,Res:Integer;
  154.    Front,Back:Byte;
  155. Function ReadData(Adr:Word;L:Byte):String;
  156. Var
  157.    Ref:String;
  158.    Ch,Res:Char;
  159.    Nx:Integer;
  160. Begin
  161.    Ref:='';
  162.    For Nx:=1 To L Do
  163.    Begin
  164.       Go((Adr Mod 160) Div 2+Nx-1,Adr Div 160);
  165.       Ch:=ReadKey;
  166.       If KeyPressed Then Res:=ReadKey;
  167.       Case Ch Of
  168.            #27:Begin
  169.                   ReadData:='-1';
  170.                   Go((Ix Mod 160) Div 2,Ix Div 160);
  171.                   Exit;
  172.                End;
  173.            #13:Break;
  174.            #8 :If Nx>=1 Then
  175.                Begin
  176.                   Ref:=Copy(Ref,1,Length(Ref)-1);
  177.                   Go((Adr Mod 160) Div 2+Nx-2,Adr Div 160);
  178.                   Nx:=Nx-2;
  179.                   MemW[Segment:Adr+Nx*2]:=WColor Shl 8+32;
  180.                   Continue;
  181.                End;
  182.       End;
  183.       If Ch In [#32..#255] Then
  184.       Begin
  185.          Ref:=Ref+Ch;
  186.          MemW[Segment:Adr+(Nx-1)*2]:=WColor Shl 8+Ord(Ch);
  187.       End;
  188.    End;
  189.    Go((Ix Mod 160) Div 2,Ix Div 160);
  190.    ReadData:=Ref;
  191. End;
  192. Begin
  193.    Init(7,0,' ',0,7,'Ekran Editörü ['+FileName+FileExt+']',0,7,
  194.    ' F1-Yardìm  F2-Kayìt  F3-Yeni  F4-Tek\Çift  F5-Renk  F6-Yaz\Çiz  Esc-Çìkìƒ');
  195.    BlockCursor;
  196.    Go(0,1);
  197.    Ix:=160;
  198.    Repeat
  199.       Ch:=ReadKey;
  200.       If (Ch=#0) And KeyPressed Then
  201.       Begin
  202.          Ch:=ReadKey;
  203.          Key:=Ord(Ch) Shl 8;
  204.       End Else Key:=Ord(Ch);
  205.       Case Key Of
  206.            27   :Done;
  207.            8    :If Ix>161 Then
  208.                  Begin
  209.                     For Jx:=Ix To Ix+158-(Ix Mod 160) Do
  210.                     Begin
  211.                        If Odd(Jx) Then Continue;
  212.                        MemW[Segment:Jx-2]:=MemW[Segment:Jx];
  213.                     End;
  214.                     MemW[Segment:Jx]:=WColor Shl 8+Ord(WallChar);
  215.                     Ix:=Ix-2;
  216.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  217.                  End;
  218.            20992:If Ix<3837 Then
  219.                  Begin
  220.                     For Jx:=Ix+156-(Ix Mod 160) DownTo Ix Do
  221.                     Begin
  222.                        If Odd(Jx) Then Continue;
  223.                        MemW[Segment:Jx+2]:=MemW[Segment:Jx];
  224.                     End;
  225.                     MemW[Segment:Ix]:=WColor Shl 8+Ord(WallChar);
  226.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  227.                  End;
  228.            21248:Begin
  229.                     For Jx:=Ix To Ix+158-(Ix Mod 160) Do
  230.                     Begin
  231.                        If Odd(Jx) Then Continue;
  232.                        MemW[Segment:Jx]:=MemW[Segment:Jx+2];
  233.                     End;
  234.                     MemW[Segment:Jx]:=WColor Shl 8+Ord(WallChar);
  235.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  236.                  End;
  237.            9    :If Ix<3825 Then
  238.                  Begin
  239.                     Ix:=Ix+16;
  240.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  241.                  End;
  242.            13   :If Ix<3680 Then
  243.                  Begin
  244.                     Ix:=Ix+160-Ix Mod 160;
  245.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  246.                  End;
  247.            3840 :If Ix>15 Then
  248.                  Begin
  249.                     Ix:=Ix-16;
  250.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  251.                  End;
  252.            0..31:;
  253.            15104:Begin
  254.                     Help;
  255.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  256.                  End;
  257.            15360:Begin
  258.                     Hea:=Header;
  259.                     Sta:=Status;
  260.                     Go(0,24);ClrEol;Write(' Dosya Adì : [        ]');
  261.                     Name:=ReadData(3868,8);
  262.                     If (Name<>'-1') And (Name<>'') Then FileName:=Name;
  263.                     Go(0,24);ClrEol;Write('Baƒlìk:[                                                                     ]');
  264.                     Name:=ReadData(3856,69);
  265.                     If Name<>'-1' Then Header:=Name
  266.                                   Else Header:='';
  267.                     Go(0,24);ClrEol;Write('Alt Yazì:[                                                                    ]');
  268.                     Name:=ReadData(3860,68);
  269.                     If Name<>'-1' Then Status:=Name
  270.                                   Else Status:='';
  271.                     InitHeader;
  272.                     InitStatus;
  273.                     ScrToFile(FileName+FileExt);
  274.                     Repeat Until KeyPressed;
  275.                     Header:='Ekran Editörü ['+FileName+FileExt+']';
  276.                     Status:=' F1-Yardìm  F2-Kayìt  F3-Yeni  F4-Tek\Çift  F5-Renk  F6-Yaz\Çiz  Esc-Çìkìƒ';
  277.                     InitHeader;
  278.                     InitStatus;
  279.                  End;
  280.            15616:Begin
  281.                     FileName:='ISIMSIZ';
  282.                     Init(7,0,' ',0,7,'Ekran Editörü ['+FileName+FileExt+']',0,7,
  283.                     ' F1-Yardìm  F2-Kayìt  F3-Yeni  F4-Tek\Çift  F5-Renk  F6-Yaz\Çiz  Esc-Çìkìƒ');
  284.                     Ix:=160;
  285.                  End;
  286.            15872:Begin
  287.                     LineMode:=Not LineMode;
  288.                     SetLineStyle(LineMode);
  289.                  End;
  290.            16384:DrawMode:=Not DrawMode;
  291.            16128:Begin
  292.                     Go(0,24);ClrEol;Write(' Yazì Rengi : [  ]');
  293.                     Val(ReadData(3870,2),Jx,Res);
  294.                     If (Res=0) And (Jx In [0..15]) Then Front:=Jx;
  295.                     Go(0,24);ClrEol;Write(' Zemin Rengi : [ ]');
  296.                     Val(ReadData(3872,1),Jx,Res);
  297.                     If (Res=0) And (Jx In [0..7]) Then Back:=Jx;
  298.                     WColor:=Back Shl 4+Front;
  299.                     InitHeader;
  300.                     InitStatus;
  301.                  End;
  302.            19712:If Ix<3837 Then
  303.                  Case DrawMode Of
  304.                       False:Begin
  305.                                If Ix<3837 Then Ix:=Ix+2;
  306.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  307.                             End;
  308.                       True :Begin
  309.                                MemW[Segment:Ix]:=WColor Shl 8+LineStyle[5];
  310.                                If Ix<3837 Then Ix:=Ix+2;
  311.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  312.                             End;
  313.                  End;
  314.            19200:Case DrawMode Of
  315.                       False:Begin
  316.                                If Ix>161 Then Ix:=Ix-2;
  317.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  318.                             End;
  319.                       True :Begin
  320.                                MemW[Segment:Ix]:=WColor Shl 8+LineStyle[5];
  321.                                If Ix>161 Then Ix:=Ix-2;
  322.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  323.                             End;
  324.                  End;
  325.            18432:Case DrawMode Of
  326.                       False:Begin
  327.                                If Ix>319 Then Ix:=Ix-160;
  328.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  329.                             End;
  330.                       True :Begin
  331.                                MemW[Segment:Ix]:=WColor Shl 8+LineStyle[6];
  332.                                If Ix>319 Then Ix:=Ix-160;
  333.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  334.                             End;
  335.                  End;
  336.            20480:Case DrawMode Of
  337.                       False:Begin
  338.                                If Ix<3680 Then Ix:=Ix+160;
  339.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  340.                             End;
  341.                       True :Begin
  342.                                MemW[Segment:Ix]:=WColor Shl 8+LineStyle[6];
  343.                                If Ix<3680 Then Ix:=Ix+160;
  344.                                Go((Ix Mod 160) Div 2,Ix Div 160);
  345.                             End;
  346.                  End;
  347.            18176:Begin
  348.                     Ix:=Ix-(Ix Mod 160);
  349.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  350.                  End;
  351.            20224:Begin
  352.                     Ix:=Ix+158-(Ix Mod 160);
  353.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  354.                  End;
  355.            30464:Begin
  356.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[1];
  357.                     If Ix<3837 Then Ix:=Ix+2;
  358.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  359.                  End;
  360.            33792:Begin
  361.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[2];
  362.                     If Ix<3680 Then Ix:=Ix+160;
  363.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  364.                  End;
  365.            29952:Begin
  366.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[3];
  367.                     If Ix>319 Then Ix:=Ix-160;
  368.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  369.                  End;
  370.            30208:Begin
  371.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[4];
  372.                     If Ix>161 Then Ix:=Ix-2;
  373.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  374.                  End;
  375.            29696:Begin
  376.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[5];
  377.                     If Ix<3837 Then Ix:=Ix+2;
  378.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  379.                  End;
  380.            17152:Begin
  381.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[7];
  382.                     If Ix<3680 Then Ix:=Ix+160;
  383.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  384.                  End;
  385.            17408:Begin
  386.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[8];
  387.                     If Ix<3837 Then Ix:=Ix+2;
  388.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  389.                  End;
  390.            16640:Begin
  391.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[9];
  392.                     If Ix<3837 Then Ix:=Ix+2;
  393.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  394.                  End;
  395.            16896:Begin
  396.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[10];
  397.                     If Ix>161 Then Ix:=Ix-2;
  398.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  399.                  End;
  400.            29184:Begin
  401.                     MemW[Segment:Ix]:=WColor Shl 8+LineStyle[11];
  402.                     If Ix<3680 Then Ix:=Ix+160;
  403.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  404.                  End;
  405.            Else  If Key In [32..255] Then Begin
  406.                     MemW[Segment:Ix]:=WColor Shl 8+Key;
  407.                     If Ix<3837 Then Ix:=Ix+2;
  408.                     Go((Ix Mod 160) Div 2,Ix Div 160);
  409.                  End;
  410.       End;
  411.    Until 1=2;
  412. End;
  413. Destructor Draw.Done;
  414. Begin
  415.    WColor:=7;
  416.    WallChar:=' ';
  417.    InitWall;
  418.    Go(0,0);
  419.    StdCursor;
  420.    Writeln('TurboSoft Screen Generator by Murat AKSARAY');
  421.    Halt;
  422. End;
  423.  
  424. End.